home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / EDWIN / MAIN.S < prev    next >
Encoding:
Text File  |  1993-08-21  |  5.3 KB  |  162 lines
  1. ;;;
  2. ;;;    Copyright (c) 1985 Massachusetts Institute of Technology
  3. ;;;
  4. ;;;    This material was developed by the Scheme project at the
  5. ;;;    Massachusetts Institute of Technology, Department of
  6. ;;;    Electrical Engineering and Computer Science.  Permission to
  7. ;;;    copy this software, to redistribute it, and to use it for any
  8. ;;;    purpose is granted, subject to the following restrictions and
  9. ;;;    understandings.
  10. ;;;
  11. ;;;    1. Any copy made of this software must include this copyright
  12. ;;;    notice in full.
  13. ;;;
  14. ;;;    2. Users of this software agree to make their best efforts (a)
  15. ;;;    to return to the MIT Scheme project any improvements or
  16. ;;;    extensions that they make, so that these may be included in
  17. ;;;    future releases; and (b) to inform MIT of noteworthy uses of
  18. ;;;    this software.
  19. ;;;
  20. ;;;    3.  All materials developed as a consequence of the use of
  21. ;;;    this software shall duly acknowledge such use, in accordance
  22. ;;;    with the usual standards of acknowledging credit in academic
  23. ;;;    research.
  24. ;;;
  25. ;;;    4. MIT has made no warrantee or representation that the
  26. ;;;    operation of this software will be error-free, and MIT is
  27. ;;;    under no obligation to provide any services, by way of
  28. ;;;    maintenance, update, or otherwise.
  29. ;;;
  30. ;;;    5.  In conjunction with products arising from the use of this
  31. ;;;    material, there shall be no use of the name of the
  32. ;;;    Massachusetts Institute of Technology nor of any adaptation
  33. ;;;    thereof in any advertising, promotional, or sales literature
  34. ;;;    without prior written consent from MIT in each case.
  35. ;;;
  36. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  37. ;;;
  38. ;;;     Modified by Texas Instruments Inc 8/15/85
  39. ;;;
  40. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41.  
  42. (define edwin-maxlines (1+ (car (window-get-size 'console))))
  43.  
  44. ;;; miscellaneous routine for windows
  45.  
  46. (define save-console-contents
  47.   (lambda ()
  48.     (set! *pcs-contents* (%save-window 'console))))
  49.  
  50. (define restore-console-contents
  51.   (lambda ()
  52.     (let ((cursor-x (%reify-port 'console 1))
  53.           (cursor-y (%reify-port 'console 0)))
  54.       (%clear-window 'console)
  55.       (%reify-port! 'console 1 cursor-x)
  56.       (%reify-port! 'console 0 cursor-y)
  57.       (%restore-window 'console *pcs-contents*))))
  58.  
  59. (define make-pcs-status-invisible
  60.   (lambda ()
  61.     (%reify-port! pcs-status-window 11
  62.                   (bitwise-and (%reify-port pcs-status-window 11) -11))))
  63.  
  64. (define make-pcs-status-visible
  65.   (lambda ()
  66.     (%reify-port! pcs-status-window 11
  67.                   (bitwise-or (%reify-port pcs-status-window 11) 10))))
  68.  
  69.  
  70. (define move-editor-to-upper-half
  71.   (lambda ()
  72.     (let ((mid (round (/ (nlines) 2))))
  73.       (%reify-port! buffer-screen 4 (-1+ mid))
  74.       (%reify-port! modeline-screen 2 (-1+ mid))
  75.       (%reify-port! typein-screen 2 mid))))
  76.  
  77. (define move-editor-to-full
  78.   (lambda ()
  79.     (%reify-port! buffer-screen 4 (- (nlines) 2))
  80.     (%reify-port! modeline-screen 2 (- (nlines) 2))
  81.     (%reify-port! typein-screen 2 (-1+ (nlines)))))
  82.  
  83. (define move-pcs-window-lower
  84.   (lambda ()
  85.     (let ((mid (round (/ (nlines) 2))))
  86.       (%reify-port! 'console 2 (1+ mid))
  87.       (%reify-port! 'console 4 (-1+ mid)))))
  88.  
  89. (define move-pcs-to-full
  90.   (lambda ()
  91.     (%reify-port! 'console 2 0)
  92.     (%reify-port! 'console 4 (-1+ (nlines)))))
  93.  
  94. (begin
  95. (define-integrable editor:name 0)
  96. (define-integrable editor:buffer-window 1)
  97. (define-integrable editor:bufferset 2)
  98. (define-integrable editor:kill-ring 3)
  99. (define-integrable editor-bufferset
  100.   (lambda (editor)
  101.     (vector-ref editor editor:bufferset)))
  102.  
  103. (define-integrable editor-kill-ring
  104.   (lambda (editor)
  105.     (vector-ref editor editor:kill-ring)))
  106.  
  107. (define-integrable editor-buffer-window
  108.   (lambda (editor)
  109.     (vector-ref editor editor:buffer-window)))
  110.  
  111. (define-integrable editor-name
  112.   (lambda (editor)
  113.     (vector-ref editor editor:name)))
  114.  
  115. (define-integrable current-buffer-set
  116.   (lambda()
  117.     (editor-bufferset edwin-editor)))
  118.  
  119. (define-integrable current-kill-ring
  120.   (lambda ()
  121.     (editor-kill-ring edwin-editor)))
  122.  
  123. (define-integrable current-buffer-window
  124.   (lambda ()
  125.     (editor-buffer-window edwin-editor)))
  126. )
  127. ;;; screens
  128.  
  129. (define make-screen
  130.   (lambda (xl yl lin col)
  131.     (let ((window (%make-window'())))
  132.       (%reify-port! window 2 yl)
  133.       (%reify-port! window 3 xl)
  134.       (%reify-port! window 4 lin)
  135.       (%reify-port! window 5 col)
  136.       (%reify-port! window 8
  137.                     (bitwise-and -2 (%reify-port window 8)))
  138.       window)))
  139.  
  140. (define buffer-screen (make-screen 0 0 (- (nlines) 2) (ncols)))
  141. (define modeline-screen
  142.   (let ((screen (make-screen 0 (- (nlines) 2) 1 (ncols))))
  143.     (%reify-port! screen 7 120)))
  144.  
  145. (define typein-screen (make-screen 0 (-1+ (nlines)) 1 (ncols)))
  146. (define blank-screen (make-screen 0 0 (-1+ (nlines)) (ncols)))
  147. ;;; editor
  148.  
  149. (define initial-buffer-name "Main")
  150.  
  151. (define make-editor
  152.   (lambda (name)
  153.     (let ((vec (make-vector 4))
  154.       (init-buffer (make-buffer initial-buffer-name)))
  155.       (let ((bufferset (make-bufferset init-buffer)))
  156.         (vector-set! vec editor:name name)
  157.         (vector-set! vec editor:buffer-window
  158.                          (make-buffer-window buffer-screen init-buffer))
  159.         (vector-set! vec editor:bufferset bufferset)
  160.         (vector-set! vec editor:kill-ring (make-ring 10))
  161.         vec))))
  162.